home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 November: Tool Chest / Dev.CD Nov 94.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / libraries / coll-ext / heap.dylan < prev    next >
Encoding:
Text File  |  1994-06-29  |  17.9 KB  |  579 lines  |  [TEXT/ttxt]
  1. module:     heap
  2. rcs-header:    $Header: heap.dylan,v 1.1 94/06/28 23:06:55 wlott Exp $
  3. author:     Nick Kramer (nkramer@cs.cmu.edu)
  4. synopsis:    Provides <heap>, a popular data structure for priority queues.
  5.         The semantics are basically those of a sorted sequence, with
  6.         particularly efficient implementations of add!, first, and pop
  7.         (i.e.  "remove-first").
  8.  
  9. //======================================================================
  10. //
  11. // Copyright (c) 1994  Carnegie Mellon University
  12. // All rights reserved.
  13. // 
  14. // Use and copying of this software and preparation of derivative
  15. // works based on this software are permitted, including commercial
  16. // use, provided that the following conditions are observed:
  17. // 
  18. // 1. This copyright notice must be retained in full on any copies
  19. //    and on appropriate parts of any derivative works.
  20. // 2. Documentation (paper or online) accompanying any system that
  21. //    incorporates this software, or any part of it, must acknowledge
  22. //    the contribution of the Gwydion Project at Carnegie Mellon
  23. //    University.
  24. // 
  25. // This software is made available "as is".  Neither the authors nor
  26. // Carnegie Mellon University make any warranty about the software,
  27. // its performance, or its conformity to any specification.
  28. // 
  29. // Bug reports, questions, comments, and suggestions should be sent by
  30. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  31. //
  32. //======================================================================
  33.  
  34. //============================================================================
  35. // A heap is an implementation of the abstract data type "sorted list". A heap
  36. // is a sorted sequence of items.  Most likely the user will end up writing
  37. // something like 
  38. // 
  39. // define class <heap-item> (<object>);
  40. //   slot priority;
  41. //   slot data;
  42. // end class <heap-item>;
  43. // 
  44. // with appropriate methods defined for < and =. The user could, however, have
  45. // simply a sorted list of integers, or have some item where the priority is
  46. // an integral part of the item itself.  
  47. // 
  48. // make on heaps supports the less-than: keyword, which supply the heap's
  49. // comparison and defaults to <.  
  50. // 
  51. // Heaps support all the usual sequence operations. The most useful ones:  
  52. // 
  53. //      push(heap, item) => updated-heap
  54. //      pop(heap)        => smallest-element
  55. //      first(heap)      => smallest-element
  56. //      second(heap)     => second-smallest-element
  57. //      add!(heap, item) => updated-heap
  58. //      sort, sort!      => sorted-sequence
  59. // 
  60. // These are all "efficient" operations (defined below).  As with <deque>,
  61. // push is another name for add!, and does exactly the same thing except that
  62. // push doesn't accept any keywords.  sort and sort! return a sequence that's
  63. // not a heap. Not necessarily efficient but useful anyhow:  
  64. // 
  65. //      add-new!(heap, item, #key test:, efficient:) => updated-heap
  66. //      remove!(heap, item, #key test:, efficient:) => updated-heap
  67. //      member?(heap, item, #key test:, efficient:) => <boolean>
  68. // 
  69. // The efficient: keyword defaults to #f. If #t, it uses the
  70. // random-iteration-protocol (which is considerably more efficient, but isn't
  71. // really standard behavior, so it had to be optional).  Conceivably most
  72. // sequence methods could support such a keyword, but they don't yet.  
  73. // 
  74. // The user can use element-setter or the iteration protocol to change an item
  75. // in the heap, but changing the priority of an item is an error and Bad
  76. // Things(tm) will happen. No error will be signaled.  Both of these
  77. // operations are very inefficient.  
  78. // 
  79. // Heaps are NOT <stretchy-collection>s, although add! and pop can magically
  80. // change the size of the heap.  
  81. // 
  82. // Efficiency: Approximate running times of different operations are given
  83. // below: (N is the size of the heap) 
  84. // 
  85. //     first, first-setter                             O(1)
  86. //     second (but not second-setter)                  O(1)
  87. //     size                                            O(1)
  88. //     add!                                            O(lg N)
  89. //     push                                            O(lg N)
  90. //     pop(heap)                                       O(lg N)
  91. //     sort, sort!                                     O(N * lg N)
  92. //     forward-iteration-protocol          
  93. //                             setup:                  O(N)
  94. //                             next-state:             O(lg N)
  95. //                             current-element:        O(1)
  96. //                             current-element-setter: O(N)
  97. //     backwards-iteration-protocol
  98. //                             setup:                  O(N * lg N)
  99. //                             next-state:             O(1)
  100. //                             current-element:        O(1)
  101. //                             current-element-setter: O(N)
  102. //     random-iteration-protocol           
  103. //                             setup:                  O(1)
  104. //                             next-state:             O(1)
  105. //                             current-element:        O(1)
  106. //                             current-element-setter: O(1)
  107. //     element(heap, M)                                O(M*lg N + N)
  108. //     element-setter(value, heap, M)                  O(N + M*lg N + M)
  109. // 
  110. // element, element-setter on arbitrary keys use the
  111. // forward-iteration-protocol (via the inherited methods), and have
  112. // accordingly bad performance.  
  113. //============================================================================
  114.  
  115. /* --------------------*/
  116.  
  117. define class <heap> (<mutable-sequence>)
  118.   slot heap-size      :: <integer>;
  119.   slot heap-data      :: <stretchy-vector>;
  120.   slot heap-less-than :: <function>;
  121. end class <heap>;
  122.  
  123. /* --------------------*/
  124.  
  125. // The size: keyword is accepted but ignored
  126.  
  127. define method initialize (h :: <heap>, #next next-method,
  128.               #key size: size,
  129.               less-than: less-than = \<)
  130.   h.heap-size      := 0;
  131.   h.heap-data      := make(<stretchy-vector>);
  132.   h.heap-less-than := less-than;
  133.   next-method();
  134. end method initialize;
  135.  
  136. /* --------------------*/
  137.  
  138. define method class-for-copy(h :: <heap>);
  139.   <stretchy-vector>;
  140. end method class-for-copy;
  141.  
  142. /* --------------------*/
  143.  
  144. define method shallow-copy(old-heap :: <heap>) => new-heap :: <heap>;
  145.   let new-heap = make(<heap>);
  146.   new-heap.heap-size := old-heap.heap-size;
  147.   new-heap.heap-data := shallow-copy(old-heap.heap-data);
  148.   new-heap.heap-less-than := old-heap.heap-less-than;
  149.   new-heap;
  150. end method shallow-copy;
  151.  
  152. /* --------------------*/
  153.  
  154. define method as(cls == <heap>, coll :: <collection>)
  155.     => (result :: <heap>);
  156.   let heap = make(<heap>);
  157.   for (elem in coll)
  158.     add!(heap, elem);
  159.   end for;
  160.   heap;
  161. end method as;
  162.  
  163. /* --------------------*/
  164.  
  165. define method size (h :: <heap>) => size :: <integer>;
  166.   h.heap-size;
  167. end method size;
  168.  
  169. /* --------------------*/
  170.  
  171. define method empty? (h :: <heap>);
  172.   h.heap-size = 0;
  173. end method empty?;
  174.  
  175. /* --------------------*/
  176.  
  177. // Inherit inefficient method for element.
  178.  
  179. define constant no-default = "no-default";
  180.  
  181. // Special case the top, which can be done efficiently
  182.  
  183. define method element(h :: <heap>, index :: singleton(0),
  184.               #key default: default = no-default);
  185.   if (empty?(h))
  186.     if (default == no-default)
  187.       error("No such element");
  188.     else 
  189.       default;
  190.     end if;
  191.   else
  192.     h.heap-data[0];
  193.   end if;
  194. end method element;  
  195.  
  196.  
  197. // Special case the second as well because it can be done semi-efficiently
  198.  
  199. define method element(h :: <heap>, index :: singleton(1),
  200.               #key default: default = no-default);
  201.   if (size(h) < 2)
  202.     if (default == no-default)
  203.       error("No such element");
  204.     else 
  205.       default;
  206.     end if;
  207.   else
  208.     h.heap-data[smaller-child(h, 0)];
  209.   end if;
  210. end method element;  
  211.  
  212. /* --------------------*/
  213.  
  214. // Special case the top, which can be done efficiently
  215.  
  216. define method element-setter(value, h :: <heap>, index :: singleton(0));
  217.   h.heap-data[0] := value;
  218.   value;
  219. end method element-setter;
  220.  
  221.  
  222. // element-setter uses element to figure out which element is the
  223. // key'th biggest, and then traverses the internal data structure
  224. // (through a call to find-index) to find that element in order to
  225. // change it.
  226.  
  227. define method element-setter(new-elt, h :: <heap>, key :: <integer>);
  228.   h.heap-data [find-index(h, h[key])] := new-elt;
  229. end method element-setter;
  230.  
  231. /* --------------------*/
  232.  
  233. define method add! (h :: <heap>, new-elt) => changed-heap :: <heap>;
  234.   h.heap-data [h.heap-size] := new-elt;
  235.   h.heap-size := 1 + h.heap-size;
  236.   upheap(h, h.heap-size - 1);
  237.   h;
  238. end method add!;
  239.  
  240. /* --------------------*/
  241.  
  242. define method add-new!(h :: <heap>, new-elt, 
  243.                #key test: test = \=, efficient: efficient = #f)
  244.     => changed-heap :: <heap>;
  245.   if (~ member?(h, new-elt, test: test, efficient: efficient))
  246.     add!(h, new-elt);
  247.   else 
  248.     h;
  249.   end if;
  250. end method add-new!;  
  251.  
  252. /* --------------------*/
  253.  
  254. define method push(h :: <heap>, new-elt)  =>  changed-heap :: <heap>;
  255.   add!(h, new-elt);
  256. end method push;
  257.  
  258. /* --------------------*/
  259.  
  260. define method pop (h :: <heap>) => smallest-item;
  261.   let smallest-item = h.heap-data [0];
  262.   h.heap-data [0] := h.heap-data [size(h) - 1];
  263. //  remove!(h.heap-data, size(h) - 1);    // Adjust stretchy vector
  264.   h.heap-size := h.heap-size - 1;
  265.   downheap(h, 0);
  266.   smallest-item;
  267. end method pop;
  268.  
  269. /* --------------------*/
  270.  
  271. // This is rather complicated because it can use two different
  272. // iteration protocols and has to be able to remove an arbitrary
  273. // number of items from the heap. Further complicating it, removing an
  274. // element from the heap disturbs it, so you have to FIND the
  275. // elements to remove, THEN remove them.
  276.  
  277. define method remove!(h :: <heap>, elt,
  278.               #key test: test = \=, efficient: efficient = #f)
  279.     => changed-heap :: <heap>;
  280.   let (init, limit, next, finished?, cur-key, cur-elt) =
  281.     if (efficient)     random-iteration-protocol(h);
  282.     else            forward-iteration-protocol(h);
  283.     end if;
  284.  
  285.   let kill-list = #();
  286.  
  287.   for (state = init then next(h, state), until finished?(h, state, limit))
  288.     if (test(elt, cur-elt(h, state)))
  289.       kill-list := add!(kill-list, cur-elt(h, state));
  290.     end if;
  291.   end for;
  292.  
  293.   for (dead-elt in kill-list)
  294.     let index = find-index(h, dead-elt);
  295.     let old-item = h.heap-data[index];
  296.     h.heap-size := h.heap-size - 1;
  297.     h.heap-data[index] := h.heap-data[h.heap-size];
  298.     let new-item = h.heap-data[index];
  299.  
  300.     if (h.heap-less-than(old-item, new-item))
  301.       upheap(h, index);
  302.     elseif (h.heap-less-than(new-item, old-item))
  303.       downheap(h, index);
  304.     end if;
  305.   end for;
  306.     
  307.   h;
  308. end method remove!;
  309.  
  310. /* --------------------*/
  311.  
  312. define method member?(h :: <heap>, elt, #key test: test = \=,
  313.               efficient: efficient = #f);
  314.   let (init, limit, next, finished?, cur-key, cur-elt) =
  315.     if (efficient)     random-iteration-protocol(h);
  316.     else            forward-iteration-protocol(h);
  317.     end if;
  318.  
  319.   block (return)
  320.     for (state = init then next(h, state), until finished?(h, state, limit))
  321.       if (test(elt, cur-elt(h, state)))
  322.     return(#t);
  323.       end if;
  324.     end for;
  325.     #f;
  326.   end block;
  327. end method member?;
  328.  
  329. /* --------------------*/
  330.  
  331. // Can't use backwards-iteration-protocol because that uses reverse
  332.  
  333. define method reverse(h :: <heap>);
  334.   let new-seq = make(class-for-copy(h), size: size(h));
  335.   for (elt in h, index = size(h) - 1  then index - 1)
  336.     new-seq[index] := elt;
  337.   end for;
  338.   new-seq;
  339. end method reverse;
  340.  
  341. /* --------------------*/
  342.  
  343. define method reverse!(h :: <heap>);
  344.   reverse(h);
  345. end method reverse!;
  346.  
  347. /* --------------------*/
  348.  
  349. define method sort(h :: <heap>, #next next-method,
  350.            #key test: test = \<, stable: stable = #f);
  351.   if (test == h.heap-less-than)
  352.     let new-seq = make(class-for-copy(h), size: size(h));
  353.     for (elt in h, index = 0 then index + 1)
  354.       new-seq[index] := elt;
  355.     end for;
  356.     new-seq;
  357.   else
  358.     sort(h.heap-data, test: test, stable: stable);
  359.   end if;
  360. end method sort;
  361.  
  362. /* --------------------*/
  363.  
  364. define method sort!(h :: <heap>, #rest key-value-pairs, #key);
  365.   apply(sort, h, key-value-pairs);
  366. end method sort!;
  367.  
  368. /* ---------------------------------------------------------------------*/
  369. // Internal functions
  370. /* ---------------------------------------------------------------------*/
  371.  
  372. // All internal operations specify things by their index into the vector.
  373.  
  374. define method parent (index :: <integer>) => parent-index :: <integer>;
  375.   floor/(index - 1, 2);
  376. end method parent;
  377.  
  378. /* --------------------*/
  379.  
  380. define method left-child (index :: <integer>)
  381.     => left-child-index :: <integer>;
  382.   2 * index + 1;
  383. end method left-child;
  384.  
  385. /* --------------------*/
  386.  
  387. define method right-child (index :: <integer>)
  388.     => right-child-index :: <integer>;
  389.   2 * index + 2;
  390. end method right-child;
  391.  
  392. /* --------------------*/
  393.  
  394. // Assumes the left child is valid, although the right child might not be.
  395.  
  396. define method smaller-child (h :: <heap>, index :: <integer>)
  397.     => smaller-child-index :: <integer>; 
  398.   if (right-child(index) = size(h))
  399.     left-child(index);            // There is no right child
  400.   elseif (h.heap-less-than(h.heap-data [right-child(index)],
  401.                h.heap-data [left-child(index)]))
  402.     right-child(index);
  403.   else
  404.     left-child(index);
  405.   end if;
  406. end method;
  407.  
  408. /* --------------------*/
  409.  
  410. // Move a small item up
  411.  
  412. define method upheap (h :: <heap>, index :: <integer>);
  413.   let item = h.heap-data [index];
  414.  
  415.   while (index ~= 0   &   
  416.        h.heap-less-than (item, h.heap-data [parent(index)]))
  417.     h.heap-data [index] := h.heap-data [parent(index)];
  418.     index := parent(index);
  419.   end while;
  420.   h.heap-data [index] := item;
  421. end method upheap;
  422.  
  423. /* --------------------*/
  424.  
  425. // Move a big item down
  426.  
  427. define method downheap (h :: <heap>, index :: <integer>);
  428.   let item = h.heap-data [index];
  429.  
  430.   while ( left-child(index) < size(h)
  431.        & h.heap-less-than(h.heap-data [smaller-child(h,index)], item))
  432.     h.heap-data [index] := h.heap-data [smaller-child(h,index)];
  433.     index := smaller-child(h,index);
  434.   end while;
  435.  
  436.   h.heap-data [index] := item;
  437. end method downheap;
  438.  
  439. /* --------------------*/
  440.  
  441. define method find-index(h :: <heap>, elt) => index :: <integer>;
  442.   let index = 0;
  443.   until (h.heap-data[index] == elt)
  444.     index := index + 1;
  445.   end until;
  446.   index;
  447. end method find-index;
  448.  
  449. /* ---------------------------------------------------------------------*/
  450. // Iteration protocols
  451. /* ---------------------------------------------------------------------*/
  452.  
  453. // Not very efficient. Each next-state operation costs lg n (where n
  454. // is the size of the heap), and it presumably costs N to set up.
  455.  
  456. define method forward-iteration-protocol (coll :: <heap>);
  457.   values(shallow-copy(coll),          // initial-state
  458.      #f,                          // limit (not used)
  459.                                   // next-state
  460.      method(h :: <heap>, state :: <heap>) => new-state :: <heap>;
  461.          pop(state);
  462.          state;
  463.      end method,
  464.  
  465.                                   // finished-state?
  466.      method(h :: <heap>, state :: <heap>, limit);
  467.          empty?(state);
  468.      end method,
  469.  
  470.                                   // current-key
  471.      method(h :: <heap>, state :: <heap>) => key :: <integer>;
  472.          h.heap-size - state.heap-size;
  473.      end method,
  474.  
  475.                                   // current-element
  476.      method(h :: <heap>, state :: <heap>)
  477.          first(state);
  478.      end method,
  479.  
  480.                                   // current-element-setter
  481.      method(value, h :: <heap>, state :: <heap>)
  482.          let index = find-index(h, first(state));
  483.          h.heap-data[index] := value;
  484.          state.heap-data[0] := value;
  485.      end method,
  486.  
  487.                                   // copy-state
  488.      method(h :: <heap>, state :: <heap>) => new-state :: <heap>;
  489.          shallow-copy(state);
  490.      end method);
  491. end method forward-iteration-protocol;
  492.  
  493. /* --------------------*/
  494.  
  495. // Not very efficient. Calling backwards-iteration-protocol takes n lg n 
  496. // time, after which each access is constant time (except for
  497. // current-element-setter, which is m lg n where m is the index of the
  498. // element that's being changed).
  499.  
  500. define method backwards-iteration-protocol (coll :: <heap>);
  501.   sorted-vector := reverse(coll);
  502.  
  503.   values(coll.heap-size - 1,          // initial-state
  504.      -1,                          // limit
  505.                                   // next-state
  506.      method(h :: <heap>, state :: <integer>) => new-state :: <integer>;
  507.          state - 1;
  508.      end method,
  509.  
  510.                                   // finished-state?
  511.      method(h :: <heap>, state :: <integer>, limit :: <integer>);
  512.          state = limit;
  513.      end method,
  514.  
  515.                                   // current-key
  516.      method(h :: <heap>, state :: <integer>) => key :: <integer>;
  517.          state;
  518.      end method,
  519.  
  520.                                   // current-element
  521.      method(h :: <heap>, state :: <integer>)
  522.          sorted-vector[state];
  523.      end method,
  524.  
  525.                                   // current-element-setter
  526.      method(value, h :: <heap>, state :: <integer>)
  527.          let index = find-index(h, sorted-vector[state]);
  528.          h.heap-data[index] := value;
  529.           sorted-vector[state] := value;
  530.      end method,
  531.  
  532.                                   // copy-state
  533.      method(h :: <heap>, state :: <integer>) => new-state :: <integer>;
  534.          state;
  535.      end method);
  536. end method backwards-iteration-protocol;
  537.  
  538. /* --------------------*/
  539.  
  540. // Just plows through the heap in the order things appear in the vector.
  541. // Constant time access. Doesn't implement current-key.
  542.  
  543. define method random-iteration-protocol (collection :: <heap>);
  544.   values(0,                      // initial-state
  545.      size(collection),                // limit
  546.  
  547.                              // next-state
  548.      method (h :: <heap>, state :: <integer>) => next-state :: <integer>;
  549.        state + 1;
  550.      end method,
  551.      
  552.                              // finished-state?
  553.      method (h :: <heap>, state :: <integer>, limit :: <integer>);
  554.        state = limit;
  555.      end method,
  556.  
  557.                              // current-key
  558.      method (h :: <heap>, state :: <integer>) => key :: <integer>;
  559.        error("I have no idea what the current-key is.");
  560.      end method,
  561.  
  562.                              // current-element
  563.      method (h :: <heap>, state :: <integer>);
  564.        h.heap-data [state];
  565.      end method,
  566.  
  567.                              // current-element-setter
  568.      method (value, h :: <heap>, state :: <integer>);
  569.        h.heap-data[state] := value;
  570.      end method,
  571.  
  572.                              // copy-state
  573.      method (h :: <heap>, state :: <integer>) => state :: <integer>;
  574.        state;
  575.      end method
  576.     );
  577. end method random-iteration-protocol;     
  578.  
  579.